home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d14
/
baswind8.arc
/
TAGLIST.SUB
< prev
next >
Wrap
Text File
|
1990-09-14
|
33KB
|
943 lines
'
'
'******************************************************************************
' Function : TAGLIST *
' *
' Purpose: *
' *
' *
' Results: *
' *
' Usage : *
' *
' *
' Date Written : 09/01/90 - Date Tested: 09/01/90 - Author: James P Morgan *
' Date Modified: - : - : *
'-----------------------------------------------------------------------------*
' NOTE: *
'******************************************************************************
' *
' SUB PROGRAM NAME (PARAMETERS) STATIC/RECURSIVE *
'-----------------------------------------------------------------------------*
' *
SUB TAGLIST(HEADER$,SHOWITEMS%,MAXITEMS%,NUMTAGGED%,ITEM$(1),TAGITEMS%(1),FORE%,BACK%,HFORE%,HBACK%,QUADRANT$,SHADOW%,RETURN.CODE%) STATIC
DEFINT A-Z 'make all short intergers by default
RETURN.CODE%=0
MAKEWIND.RETURN.CODE=0
SETQUAD.RETURN.CODE=0
VIDEO.RETURN.CODE=0
ITEM.MIN=LBOUND(ITEM$) 'adjust for callers OPTION BASE
ITEM.MAX=UBOUND(ITEM$) 'save array upper limits
SELECT.BASE=1-ITEM.MIN 'normalize to a base of 1
'
' insure array to hold tag flag dimensioned same as array being tagged
'
IF (LBOUND(TAGITEMS%)<>ITEM.MIN) OR (UBOUND(TAGITEMS%)<>ITEM.MAX) THEN
NUMTAGGED%=-1 'nothing noted as being selected
GOTO TAGLIST.DONE 'were are thru
END IF
'
' add code to check that MAXITEMS dosnt go outside array bounds (+ or -)
'
IF SHOWITEMS% > MAXITEMS% THEN 'we cant show more than whats avail
SHOWITEMS%=MAXITEMS%
END IF
TEMP.ITEM$=STRING$(255," ")
BEGVAL=1
MENU.TOP.ROW=0
MENU.TOP.LEFT.COL=0
MENU.BOTTOM.ROW=0
MENU.BOTTOM.RIGHT.COL=0
BUTTONS%=0 'assume no mouse support avail
CALL MMCHECK(BUTTONS%) 'see if mouse support avail
GOSUB TAGLIST.MMCURSORON
'
MOUSECOL=0 'locate the mouse cursor in upper
MOUSEROW=0 'left top corner of screen
CALL MMSETLOC(MOUSECOL,MOUSEROW) 'move the mouse cursor
FIRST.TIME=-1
GOSUB TAGLIST.MMCURSOROFF
MAX.NUMTAGGED.ALLOWED=MAXITEMS% 'assume we can tag all the items
IF NUMTAGGED%>0 THEN 'can we tag all the items?
MAX.NUMTAGGED.ALLOWED=NUMTAGGED% 'no, only this many can be tagged
NUMTAGGED%=0
END IF
WINDLEN=LEN(HEADER$) 'assume window length is header length
'Determine width of window from length of items
FOR J=ITEM.MIN TO ITEM.MIN+MAXITEMS%
ASCIIZ=INSTR(ITEM$(J),CHR$(0)) 'allow for an imbedded null x'00'
LEN.ITEM=ASCIIZ-1 'char in a string
IF LEN.ITEM<1 THEN
LEN.ITEM=LEN(ITEM$(J))
END IF
IF LEN.ITEM > WINDLEN THEN
WINDLEN=LEN.ITEM
END IF
NEXT
'If Quadrant is in ROW:COL format, extract Row and Column
IF INSTR(QUADRANT$,":")<>0 THEN 'was an absolute row:column specified
GOSUB TAGLIST.GETORD
GOTO TAGLIST.GO1
END IF
'Determine Position based on Quadrant Parameter and size of menu
QUADRANT=VAL(QUADRANT$) 'The window is to be in 1 of the 5 quadrants
IF QUADRANT <0 OR QUADRANT >4 THEN 'make sure the quadrant is valid
QUADRANT=0 'if invalid, default to center of screen
END IF
CALL SETQUAD(QUADRANT,CROW,CCOL,WINDLEN,SHOWITEMS%,SETQUAD.RETURN.CODE)
ULR%=CROW-((SHOWITEMS%+2)/2-.5) 'the upper left row:column window co-ordinates
ULC%=CCOL-((WINDLEN/2)-.5)
LRR%=ULR%+SHOWITEMS%+1 'the lower right window co-ordinates
LRC%=ULC%+WINDLEN-1
'
'Create Window for List
TAGLIST.GO1:
MENU.TOP.ROW=ULR%+2 'allow for the menu name box above the window
MENU.TOP.LEFT.COL=ULC%
MENU.BOTTOM.ROW=LRR%
MENU.BOTTOM.RIGHT.COL=LRC%
FRAME%=4
CALL MAKEWIND(ULR%,ULC%,LRR%,LRC%,FRAME,FORE%,BACK%,GROW,SHADOW%,LABEL$,MAKEWIND.RETURN.CODE)
TEMPHDR$=SPACE$(WINDLEN) 'make menu header as big as biggest item
IF LEN(HEADER$)<>WINDLEN THEN 'does the menu header need centering?
GOSUB TAGLIST.PUTHDR 'YES
END IF
ATTR=(HBACK% AND 7)*16+HFORE% 'display the menu header
ROW=ULR%
COL=ULC%
CALL FASTPRT(HEADER$,ROW,COL,ATTR,VIDEO.RETURN.CODE)
ATTR=(BACK% AND 7)*16+FORE% 'bracket the menu header in the window
ROW=ULR%+1
COL=ULC%
DAT$=STRING$(WINDLEN,205)
CALL FASTPRT(DAT$,ROW,COL,ATTR,VIDEO.RETURN.CODE)
'Set current choice to List Item #1, Set Beginning and Ending values,
'Display 'More...' message and enter Loop
NUMTAGGED%=0 'startoff assuming no items tagged
SELECT.%=1 'display the first group of items
OLD=SELECT.%
BEGVAL=1 'starting with the first item
ENDVAL=SHOWITEMS% 'and ending with the max we can display at once
GOSUB TAGLIST.FILL
FIRST.TIME=0
'
TAGLIST.LOOP:
GOSUB TAGLIST.PRESS 'Get KeyPress
IF KP$=CHR$(13) OR KP$=CHR$(27) THEN 'was Enter or ESC key pressed?
GOTO TAGLIST.DONE 'yes, were are thru
END IF
GOTO TAGLIST.LOOP 'keep waiting for user to press a key
'
'Check for KeyPress and sound error if not UP ARROW, DOWN ARROW, HOME, END, PAGE UP, PAGE DOWN, or RETURN
TAGLIST.PRESS:
CLICK=-1 'flush any mouse clicks
DO WHILE CLICK
LFT%=0
RGT%=0
CALL MMCLICK(LFT%,RGT%)
CLICK=LFT%+RGT%
LOOP
GOSUB TAGLIST.GET.PRESS
IF KP$="" THEN 'wait for a key or mouse click
GOTO TAGLIST.PRESS
END IF
'
' Was a INS or DEL key pressed
'
IF LEN(KP$)=2 THEN 'was an extended function key pressed?
IF MID$(KP$,2,1)=CHR$(82) OR MID$(KP$,2,1)=CHR$(83) THEN
GOTO TAGLIST.PRESS.ON
ELSE
GOTO TAGLIST.DOWN 'see if cursor down pressed
END IF
END IF
'
TAGLIST.PRESS.ON:
IF KP$=CHR$(13) THEN 'Enter key pressed?
RETURN
END IF
IF KP$=CHR$(27) THEN 'ESC key pressed
NUMTAGGED%=-1 'nothing noted as being selected
RETURN
END IF
SELECT.SUB=(SELECT.%-SELECT.BASE)
IF LEN(KP$)<>2 THEN 'was an extened function key pressed?
GOTO TAGLIST.PRESS.CONT 'no
END IF
KP$=RIGHT$(KP$,1) 'get the function key code pressed
'
' Check if INS key pressed and we are allowed to tag anymore items
'
IF ((KP$=CHR$(82)) AND (TAGITEMS%(SELECT.SUB)=0)) THEN
IF NUMTAGGED+1<=MAX.NUMTAGGED.ALLOWED THEN
TAGITEMS%(SELECT.SUB)=1 'tag this item
NUMTAGGED%=NUMTAGGED%+1 'we have 1 more item tagged
GOSUB TAGLIST.FILL 'turn on the tag flag for this displayed item
GOTO TAGLIST.PRESS
ELSE
GOTO TAGLIST.PRESS.SOUNDOFF 'let user know this one already tagged
END IF
END IF
'
' Check if DEL key pressed and if this item is tagged
'
IF ((KP$=CHR$(83)) AND (TAGITEMS%(SELECT.SUB)=1)) THEN
TAGITEMS%(SELECT.SUB)=0 'untagg this item
NUMTAGGED%=NUMTAGGED%-1 'we now have 1 less items tagged
GOSUB TAGLIST.FILL 'turn off the tag flag on the displayed item
GOTO TAGLIST.PRESS
END IF
GOTO TAGLIST.PRESS.SOUNDOFF 'an error/problem,so let user know
TAGLIST.PRESS.CONT:
GOSUB TAGLIST.FIND.OPTION 'find the first char of an item that matches key pressed
IF SELECT.%<>SAVE.SELECT THEN 'was a new item found?
RETURN 'YES
END IF
TAGLIST.PRESS.SOUNDOFF:
GOSUB TAGLIST.SOUNDOFF 'NO, a new item not found!
GOTO TAGLIST.PRESS
'
'Process DOWN ARROW KeyPress
TAGLIST.DOWN:
IF ASC(RIGHT$(KP$,1))=80 THEN 'was cursor down key pressed?
SELECT.%=SELECT.%+1 'this is the new item we want highlighted
ELSE
GOTO TAGLIST.UP 'NO, see if cursor up
END IF
IF SELECT.% > MAXITEMS% THEN 'are we at the end of the items?
SELECT.% = MAXITEMS% 'cant go past the end of the items
GOSUB TAGLIST.SOUNDOFF
RETURN
END IF
IF (SELECT.% > ENDVAL) AND (SELECT.% = MAXITEMS%) THEN
BEGVAL=BEGVAL+1
ENDVAL=ENDVAL+1
OLD=0
GOSUB TAGLIST.FILL
RETURN
END IF
'
' have we requested an item on the next screen of items
'
IF (SELECT.% > ENDVAL) AND (SELECT.% <> MAXITEMS%) THEN
BEGVAL=BEGVAL+1
ENDVAL=ENDVAL+1
OLD=0
GOSUB TAGLIST.FILL
RETURN
END IF
'
' highlight the next item
GOSUB TAGLIST.FILL
RETURN
'
'Process UP ARROW KeyPress
TAGLIST.UP:
IF ASC(RIGHT$(KP$,1))=72 THEN 'was cursor up key pressed?
SELECT.%=SELECT.%-1 'this is the new item we want highlighted
ELSE
GOTO TAGLIST.PG.UP 'NO, see if page up
END IF
IF SELECT.% < 1 THEN 'are we at the top of the items?
SELECT.%=1 'cant go past the top
GOSUB TAGLIST.SOUNDOFF
RETURN
END IF
IF (SELECT.% < BEGVAL) AND (SELECT.% = 1) THEN
BEGVAL=BEGVAL-1
ENDVAL=ENDVAL-1
OLD=0
GOSUB TAGLIST.FILL
RETURN
END IF
'
' have we requested an item on the next screen of items
'
IF (SELECT.% < BEGVAL) AND (SELECT.% <> 1) THEN
BEGVAL=BEGVAL-1
ENDVAL=ENDVAL-1
OLD=0
GOSUB TAGLIST.FILL
RETURN
END IF
'
' highlight the next item
GOSUB TAGLIST.FILL
RETURN
'
'Process PAGE UP KeyPress
TAGLIST.PG.UP:
IF ASC(RIGHT$(KP$,1))=73 THEN 'was page up key pressed?
OLD=SELECT.% 'this is the current item highlighted
SELECT.%=SELECT.%-SHOWITEMS% 'this is the new item we want highlighted
ELSE
GOTO TAGLIST.PG.DN 'NO, see if cursor down
END IF
IF SELECT.% < 1 THEN 'are we at the first screen of items?
KP$=CHR$(0)+CHR$(79) 'simulate a END key press
SELECT.%=OLD
GOTO TAGLIST.ENDK
END IF
BEGVAL=BEGVAL-SHOWITEMS% 'calculate the first and last items in next screen
ENDVAL=ENDVAL-SHOWITEMS%
IF BEGVAL < 1 THEN 'we cant go past first item
BEGVAL=1 'point to first item
ENDVAL=SHOWITEMS%
END IF
GOSUB TAGLIST.FILL 'highlight the item
RETURN
'
'Process PAGE DOWN KeyPress
TAGLIST.PG.DN:
IF ASC(RIGHT$(KP$,1))=81 THEN 'was page down key pressed?
OLD=SELECT.% 'this is the current item highlighted
SELECT.%=SELECT.%+SHOWITEMS% 'this is the new item we want highlighted
ELSE
GOTO TAGLIST.HOME 'NO, see if home pressed
END IF
IF SELECT.% > MAXITEMS% THEN 'are we at the last screen of items?
IF ENDVAL>=MAXITEMS% THEN
KP$=CHR$(0)+CHR$(71) 'simulate a HOME key press
SELECT.%=OLD
GOTO TAGLIST.HOME
END IF
END IF
BEGVAL=BEGVAL+SHOWITEMS% 'calculate the first and last items in next screen
ENDVAL=ENDVAL+SHOWITEMS%
IF ENDVAL > MAXITEMS% THEN 'we cant go past the last item
ENDVAL=MAXITEMS% 'point to last item
BEGVAL=(ENDVAL-SHOWITEMS%)+1
OLD=ENDVAL
SELECT.%=OLD
END IF
GOSUB TAGLIST.FILL 'highlight the item
RETURN
'
'Process HOME KeyPress
TAGLIST.HOME:
IF ASC(RIGHT$(KP$,1))=71 THEN 'was home key pressed?
OLD=SELECT.% 'this is the current item highlighted
ELSE
GOTO TAGLIST.ENDK 'NO, see if end key pressed
END IF
IF SELECT.%=1 THEN
GOSUB TAGLIST.SOUNDOFF
RETURN
END IF
SELECT.%=1 'display the first group of items
BEGVAL=1 'point to the first item
ENDVAL=BEGVAL+SHOWITEMS%-1 'and display the first screen of this many items
GOSUB TAGLIST.FILL
RETURN
'
'Process END KeyPress
TAGLIST.ENDK:
IF ASC(RIGHT$(KP$,1))=79 THEN 'was end key pressed?
OLD=SELECT.% 'this is the current item highlighted
ELSE
GOTO TAGLIST.ERRCHK 'NO, let user know invalid key pressed
END IF
IF SELECT.%=MAXITEMS% THEN
GOSUB TAGLIST.SOUNDOFF
RETURN
END IF
SELECT.%=MAXITEMS% 'display the last group of items
OLD=SELECT.% 'force screen re-display
ENDVAL=MAXITEMS% 'point to the last item
BEGVAL=ENDVAL-SHOWITEMS%+1 'display screen of last group of items
GOSUB TAGLIST.FILL
RETURN
'
'Process ERROR
TAGLIST.ERRCHK:
GOSUB TAGLIST.SOUNDOFF 'let user know problem/error
GOTO TAGLIST.PRESS
'
'Fill Contents of window
TAGLIST.FILL:
IF BEGVAL < 1 THEN 'make sure we dont go out of bounds
BEGVAL=1
END IF
IF ENDVAL > MAXITEMS% THEN 'make sure we dont go past the end of the items
ENDVAL=MAXITEMS%
END IF
OFFSET=ENDVAL-SELECT.%
IF OFFSET < 0 THEN
OFFSET = 0
ELSEIF OFFSET > SHOWITEMS%-1 THEN
OFFSET = SHOWITEMS%-1
END IF
GOSUB TAGLIST.MMCURSOROFF
'
' If next item to be hi-lited is on same screen already display, dont re-
' display all options, BUT turn off current hi-lited option and just turn
' on next item to be hi-lited (on this screen of options).
'
IF OLD<>SELECT.% THEN
IF (OLD>=BEGVAL) AND (OLD<=ENDVAL) THEN
ATTR=(BACK% AND 7)*16+FORE%
ROW=ROW
COL=ULC%
IF TAGITEMS%(OLD-SELECT.BASE)=1 THEN
MID$(ITEM$(OLD-SELECT.BASE),2,1)=CHR$(16)
ELSE
MID$(ITEM$(OLD-SELECT.BASE),2,1)=" "
END IF
DAT$=ITEM$(OLD-SELECT.BASE)
ASCIIZ=INSTR(DAT$,CHR$(0)) 'display ONLY the string upto
IF ASCIIZ>1 THEN 'a null x'00' if one is imbedded
DAT$=LEFT$(DAT$,ASCIIZ-1)
END IF
DAT$=DAT$+SPACE$(WINDLEN) 'make all items the same length
DAT$=LEFT$(DAT$,WINDLEN) 'when they are displayed
CALL FASTPRT(DAT$,ROW,COL,ATTR,VIDEO.RETURN.CODE)
GOTO TAGLIST.HILITE
END IF
END IF
K=1
'
' display the group of items we need
'
FOR J=BEGVAL TO ENDVAL
ATTR=(BACK% AND 7)*16+FORE%
ROW=(ULR%+1+K)
COL=ULC%
IF TAGITEMS%(J-SELECT.BASE)=1 THEN
MID$(ITEM$(J-SELECT.BASE),2,1)=CHR$(16)
ELSE
MID$(ITEM$(J-SELECT.BASE),2,1)=" "
END IF
DAT$=ITEM$(J-SELECT.BASE)
ASCIIZ=INSTR(DAT$,CHR$(0)) 'allow for imbedded null x'00'
IF ASCIIZ>1 THEN 'char in a string, to restrict
DAT$=LEFT$(DAT$,ASCIIZ-1) 'the amount of string displayed
END IF
DAT$=DAT$+SPACE$(WINDLEN) 'make all the displayed messages
DAT$=LEFT$(DAT$,WINDLEN) 'the same size
CALL FASTPRT(DAT$,ROW,COL,ATTR,VIDEO.RETURN.CODE)
K=K+1
NEXT
'
'highlight the next item displayed
TAGLIST.HILITE:
ATTR=(FORE% AND 7)*16+BACK%
IF BEGVAL=1 AND SELECT.%=1 THEN
ROW=ULR%+2
ELSEIF (SELECT.% >= BEGVAL) AND (SELECT.% <= ENDVAL) THEN
ROW=ULR%+2+SELECT.%
END IF
IF (ENDVAL=MAXITEMS%) AND (SELECT.%>=MAXITEMS%) THEN
SELECT.%=MAXITEMS%
ROW=LRR%
ELSE
ROW=LRR%-OFFSET
END IF
COL=ULC%
SELECT.SUB=(SELECT.%-SELECT.BASE)
IF TAGITEMS%(SELECT.SUB)=1 THEN
MID$(ITEM$(SELECT.SUB),2,1)=CHR$(16)
ELSE
MID$(ITEM$(SELECT.SUB),2,1)=" "
END IF
DAT$=ITEM$(SELECT.SUB)
ASCIIZ=INSTR(DAT$,CHR$(0))
IF ASCIIZ>1 THEN 'allow for imbedded null x'00'
DAT$=LEFT$(DAT$,ASCIIZ-1) 'char in a string, to restrict
END IF 'the amount of string displayed
DAT$=DAT$+SPACE$(WINDLEN) 'make all the displayed messages
DAT$=LEFT$(DAT$,WINDLEN) 'the same size
'
' display this selected item, and highlight it
CALL FASTPRT(DAT$,ROW,COL,ATTR,VIDEO.RETURN.CODE)
IF FIRST.TIME THEN
MOUSEROW=(ROW-1)*8 'if so, put the mouse cursor on the new selection
MOUSECOL=(COL+(LEN(DAT$)\2)-1)*8
CALL MMSETLOC(MOUSECOL,MOUSEROW)
END IF
OLD=SELECT.% 'fixes problem with item being highlighed twice
GOSUB TAGLIST.MORE 'put arrows on top and bottom of window
CLICK=-1
DO WHILE CLICK 'flush mouse click , if holding down button
LFT%=0
RGT%=0
CALL MMCLICK(LFT%,RGT%) 'see if mouse clicked on the current highlighted item
CLICK=LFT%+RGT% 'was right or left button clicked?
LOOP
GOSUB TAGLIST.MMCURSORON
RETURN
'
'Display arrowhead on top or bottom of window as necessary
TAGLIST.MORE:
IF SHOWITEMS%=MAXITEMS% THEN 'are we doing POPMENU
RETURN 'yes, all items displayed at once
END IF
MCOL=ULC%+((LRC%-ULC%)/2)-3 'calculate the windows upper frame location
DAT$=" "+CHR$(30)+" "+CHR$(205)+" "+CHR$(31)+" "
MROW=ULR%+1
GOSUB TAGLIST.DISP
MROW=LRR%+1
GOSUB TAGLIST.DISP
RETURN
'
TAGLIST.DISP:
ATTR=(BACK% AND 7)*16+FORE%
CALL FASTPRT(DAT$,MROW,MCOL,ATTR,VIDEO.RETURN.CODE)
RETURN
'
'
' Scan the list of items item looking for an item whose fitst character
'matches the keyboard character the user just typed.
'
TAGLIST.FIND.OPTION:
SAVE.SELECT=SELECT.% 'save the current item highlighted
TEMP.SELECT=SELECT.%
FIRST.CHAR$=KP$ 'this is the character to look for
'make test case in-sensative
'
FIRST.CHAR$=UCASE$(FIRST.CHAR$) 'make test case in-sensative
COUNT=0 'how many items have looked at
TAGLIST.FIND.LOOP:
TEMP.SELECT=TEMP.SELECT+1 'look at the item after the current one
IF TEMP.SELECT>MAXITEMS% THEN 'are we at the end of the list
TEMP.SELECT=1 'Yes start back at the first item in the list
END IF
COUNT=COUNT+1 'we have looked at this many items so far
IF COUNT>MAXITEMS% THEN 'have we looked at all the items in the list
RETURN 'YES
END IF
MID$(TEMP.ITEM$,1)=ITEM$(TEMP.SELECT-SELECT.BASE)
LEN.TEMP.ITEM=LEN(ITEM$(TEMP.SELECT-SELECT.BASE))
'
'scan over leading spaces for this item, up to first character
'
FOR I=1 TO LEN.TEMP.ITEM
IF MID$(TEMP.ITEM$,I,1)<>" " THEN
'
' make comparison case in-sensative
'
IF UCASE$(MID$(TEMP.ITEM$,I,1))=FIRST.CHAR$ THEN
GOTO TAGLIST.FOUND.IT 'this one was a match
ELSE
GOTO TAGLIST.FIND.LOOP 'not this one, keep looking
END IF
END IF
NEXT
GOTO TAGLIST.FIND.LOOP 'not this one, keep looking
'
TAGLIST.FOUND.IT:
SELECT.%=TEMP.SELECT 'this is the item to select now
IF (SELECT.%>=BEGVAL) AND (SELECT.%<=ENDVAL) THEN 'new item on diff. screen
GOTO TAGLIST.FOUND.IT.CONT 'NO
ENDIF
OLD=SELECT.% 'yes, force new screen re-display
BEGVAL=SELECT.% 'start the display window with this item
ENDVAL=(BEGVAL+SHOWITEMS%)-1 'and end with this item
IF ENDVAL > MAXITEMS% THEN 'are there enought items to fill this window
ENDVAL=MAXITEMS% 'NO, so display the last group of items
BEGVAL=(ENDVAL-SHOWITEMS%)+1 'and highlight the one found
END IF
TAGLIST.FOUND.IT.CONT:
GOSUB TAGLIST.FILL 'display the group of items and highlight one found
OLD=SELECT.%
RETURN
'
'
' Look for a keyboard key press or a mouse action and return a 'keystroke'
'
TAGLIST.GET.PRESS:
IF BUTTONS%=0 THEN 'is a mouse supported?
GOTO TAGLIST.GET.INKEY 'no, just look at the keyboard
END IF
CALL MMGETLOC(MOUSECOL,MOUSEROW) 'get the current mouse cursor scrren location
MOUSEROW=(MOUSEROW\8)+1 'convert row to 80x25 co-ordinates
MOUSECOL=(MOUSECOL\8)+1 'convert columnto 80x25 co-ordinates
'
' Check if the mouse is still in the window box
'
TAGLIST.CHECK.IF.INBOX:
'
' Is the mouse outside the window frame
'
IF (MOUSEROW<MENU.TOP.ROW) OR (MOUSEROW>MENU.BOTTOM.ROW) THEN
GOTO TAGLIST.OUTSIDE.BOX
END IF
'
' Is the mouse in the box or on the window frame
'
IF (MOUSECOL>=MENU.TOP.LEFT.COL) AND (MOUSECOL<=MENU.BOTTOM.RIGHT.COL) THEN
GOTO TAGLIST.FOUNDIT
END IF
'
' Mouse cursor is outside the window, did user click any buttons
'
TAGLIST.OUTSIDE.BOX:
LFT%=0
RGT%=0
CALL MMCLICK(LFT%,RGT%) 'see if left or right button clicked?
CLICK=LFT%+RGT%
IF CLICK=0 THEN 'any button clicked?
GOTO TAGLIST.OUTSIDE.BOX.CONT 'NO
END IF
'
'If any button clicked outside window then simualte an ESC key press
'
IF (MOUSECOL<MENU.TOP.LEFT.COL-1) OR (MOUSECOL>MENU.BOTTOM.RIGHT.COL+1) THEN
KP$=CHR$(27) 'simulate ESC key press
RETURN
END IF
'
' Mouse was clicked on the top or bottom window frame, get the character under
'the mouse cursor (on the screen)
'
SCREEN.CHR=SCREEN(MOUSEROW,MOUSECOL)
KP$=CHR$(0)+CHR$(73) 'assume 'page up' to be simulated
IF MOUSEROW=MENU.TOP.ROW-1 THEN 'mouse on upper window frame?
IF SHOWITEMS%<>MAXITEMS% THEN 'are we doing POPMENU
IF SCREEN.CHR=31 THEN 'NO, user click on 'down' arrow
KP$=CHR$(0)+CHR$(81) 'YES, simulate 'page down' keystroke
RETURN
ELSEIF SCREEN.CHR=30 THEN 'was mouse cursor on 'up' character
RETURN
ELSE
RETURN
END IF
END IF
END IF
KP$=CHR$(0)+CHR$(81) 'assume 'page down' to be simulated
IF MOUSEROW=MENU.BOTTOM.ROW+1 THEN 'mouse on bottom window frame?
IF SHOWITEMS%<>MAXITEMS% THEN 'are we doing POPMENU
IF SCREEN.CHR=30 THEN 'NO, user click on 'up' arrow
KP$=CHR$(0)+CHR$(73) 'YES, simulate 'page up' keystroke
RETURN
ELSEIF SCREEN.CHR=31 THEN 'was mouse on 'down' character
RETURN
ELSE
RETURN
END IF
END IF
END IF
KP$=CHR$(27) 'Simualate an ESC keypress
RETURN
TAGLIST.OUTSIDE.BOX.CONT:
GOTO TAGLIST.GET.INKEY 'see if a keyboard key pressed
'
TAGLIST.FOUNDIT:
SELECT.%=BEGVAL+(MOUSEROW-MENU.TOP.ROW) 'this is the one we want to highlight now
IF SELECT.%<>OLD THEN 'are we on the same one as is currently highlighted
LFT%=0
RGT%=0
CALL MMCLICK(LFT%,RGT%) 'see if mouse clicked on the current highlighted item
CLICK=LFT%+RGT% 'was right or left button clicked?
IF CLICK THEN 'a button clicked?
GOSUB TAGLIST.FILL 'NO, so highlight the newone just selected with the mouse
OLD=SELECT.%
ELSE
SELECT.%=OLD
GOTO TAGLIST.GET.INKEY
END IF
END IF
SELECT.%=OLD
LFT%=0
RGT%=0
CALL MMCLICK(LFT%,RGT%) 'see if mouse clicked on the current highlighted item
CLICK=LFT%+RGT% 'was right or left button clicked?
IF CLICK=0 THEN 'a button clicked?
GOTO TAGLIST.GET.INKEY 'NO
END IF
IF RGT% THEN 'was right button pressed?
CLICK=0
KP$=CHR$(13) 'Yes simulate a ENTER keypress
RETURN
END IF
IF LFT%<1 THEN 'was left button pressed
GOTO TAGLIST.GET.INKEY 'NO
END IF
KP$=CHR$(0)+CHR$(82) 'assume INS keypress to be simulated
IF TAGITEMS%(SELECT.SUB)=1 THEN 'if item already tagged
KP$=CHR$(0)+CHR$(83) 'simulate a DEL keypress
END IF
RETURN
'
TAGLIST.GET.INKEY:
KP$=INKEY$ 'get a keyboard keypress character, if one avail.
IF LEN(KP$)=0 THEN 'keep looking for a mouse or keyboard action
GOTO TAGLIST.GET.PRESS
END IF
RETURN
'
'
' The Window upper left frame co-ordinates were defined
'
TAGLIST.GETORD:
QUADRANT$=LTRIM$(QUADRANT$) 'strip off any leading and trailing spaces
QUADRANT$=RTRIM$(QUADRANT$)
COLON.LOC=INSTR(QUADRANT$,":") 'find where the row/column separator char is loacted
IF COLON.LOC=1 THEN 'was a row defined
QUADRANT$="01"+QUADRANT$ 'NO, so default to row 02
COLON.LOC=3
END IF
ULR%=VAL(LEFT$(QUADRANT$,COLON.LOC-1)) 'convert row to a interger. to work with
IF (ULR%<1) OR (ULR%>24) THEN 'is row in valid range of screen co-ordinates
ULR%=2 'no, so default to row 02
END IF
IF COLON.LOC=LEN(QUADRANT$) THEN 'was a column co-ordinate defined
QUADRANT$=QUADRANT$+"00" 'NO, so default to 00
END IF
ULC%=VAL(MID$(QUADRANT$,COLON.LOC+1)) 'convert column to interger, to work with
IF (ULC%<1) OR (ULC%>80) THEN 'is the column in a valid range
GOSUB TAGLIST.CENTER.ON.THE.LINE 'NO, so center the window on the row
END IF
QUADRANT.ROW$=STR$(ULR%) 'return the string of the row and column we are working with
QUADRANT$="0"+RIGHT$(QUADRANT.ROW$,LEN(QUADRANT.ROW$)-1)+":"
QUADRANT.COL$=STR$(ULC%)
QUADRANT$=QUADRANT$+"0"+RIGHT$(QUADRANT.COL$,LEN(QUADRANT.COL$)-1)
LRR%=ULR%+SHOWITEMS%+1 'calculate the windows lower right row and column co-ord.
LRC%=ULC%+WINDLEN-1
RETURN
'
TAGLIST.CENTER.ON.THE.LINE:
TEMP.ULC%=40-(WINDLEN/2) 'calculate the center point on the row
IF (ULC%<2) THEN 'would window be outside screen?
TEMP.ULC%=2 'put it back in scrren and allow for frame (but not shadow)
END IF
ULC%=TEMP.ULC% 'this is the upper left column needed to center this window
RETURN
'
'
' Center the window frame header, within the window.
'
TAGLIST.PUTHDR:
PAD=(WINDLEN/2)-(LEN(HEADER$)/2)-.5
MID$(TEMPHDR$,PAD+1,LEN(HEADER$))=HEADER$
HEADER$=TEMPHDR$
RETURN
'
TAGLIST.MMCURSORON:
IF BUTTONS%=0 THEN 'is a mouse supported?
RETURN 'NO
END IF
IF MOUSE.CURSOR=0 THEN 'is the mouse off at present?
CALL MMCURSORON 'YES, turn it on
MOUSE.CURSOR=-1
END IF
RETURN
TAGLIST.MMCURSOROFF:
IF BUTTONS%=0 THEN 'is a mouse supported?
RETURN 'NO
END IF
IF MOUSE.CURSOR=-1 THEN 'is the mouse on at present?
CALL MMCURSOROFF 'YES, turn it off
MOUSE.CURSOR=0
END IF
RETURN
'
TAGLIST.SOUNDOFF:
SOUND 1000,1
SOUND 1500,2
SOUND 500,1
RETURN
'
TAGLIST.DONE:
GOSUB TAGLIST.MMCURSOROFF 'turn the mouse off as we leave
TEMP.ITEM$="" 'free string space
HEADER$=""
TEMPHDR$=""
DAT$=""
END SUB